unit uDZHttp;

interface

uses
  SysUtils, Classes, Windows, uDZLibApi, uDZLib, uDZStr, uDZStream, uDZBase64, uDZWinsock2,
  uDZSocketUtils, uDZSocket, uDZIOCP, uDZHttpTypes;

const
  INVALID_CHUNK_SIZE: LongWord = LongWord(-1);
  INVALID_CONTENT_LENGTH: LongWord = LongWord(-1);

type
  TDzHttpMethod = (hmGet, hmPost, hmHead, hmPut, hmDelete);

  THttpResponseState = (hssError, hssComplete, hssLine, hssHeader, hssContent);

  THttpErrorCode = (errConnect, errRecv, errSend, errInvalidStream);

  TAnsiAnsiPair = record
    Key: AnsiString;
    Value: AnsiString;
  end;
  PAnsiAnsiPair = ^TAnsiAnsiPair;

  PAnsiAnsiLinkListNode = ^TAnsiAnsiLinkListNode;
  TAnsiAnsiLinkListNode = record
    Next: PAnsiAnsiLinkListNode;
    Data: TAnsiAnsiPair;
  end;
  PPAnsiAnsiLinkListNode = ^PAnsiAnsiLinkListNode;

  TAnsiAnsiMap = class
  private
    fListHead: PAnsiAnsiLinkListNode;
    fCaseSensitive: Boolean;
    function FindItem(const Key: AnsiString;
      Prev: PPAnsiAnsiLinkListNode = nil): PAnsiAnsiLinkListNode;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Append(Map: TAnsiAnsiMap);
    procedure Assign(Map: TAnsiAnsiMap);
    function GetItem(const Key: AnsiString): AnsiString;
    procedure SetItem(const Key, Value: AnsiString);
    function Exists(const Key: AnsiString): Boolean;
    procedure Delete(const Key: AnsiString);
    procedure Clear;
    property CaseSensitive: Boolean read fCaseSensitive write fCaseSensitive;
    property ListHead: PAnsiAnsiLinkListNode read fListHead;
  end;

  TAnsiAnsiMapIterator = object
  private
    Node: PAnsiAnsiLinkListNode;
    function GetKey: AnsiString;
    function GetValue: AnsiString;
    procedure SetValue(const AValue: AnsiString);
  protected
    PropDummy: Integer;
  public
    procedure SetMap(const Map: TAnsiAnsiMap);
    procedure Next;
    function Eof: Boolean;
    property Key: AnsiString read GetKey;
    property Value: AnsiString read GetValue write SetValue;
  end;

  TDzHttpPackage = class
  private
    fHeader: TAnsiAnsiMap;
    function GetContentType: AnsiString;
    procedure SetContentType(const Value: AnsiString);
    function GetConnection: AnsiString;
    procedure SetConnection(const Value: AnsiString);
    function GetContentLength: LongWord;
    procedure SetContentLength(const Value: LongWord);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure AddHeader(const Name, Value: AnsiString);
    property Header: TAnsiAnsiMap read fHeader;
    property ContentType: AnsiString read GetContentType write SetContentType;
    property Connection: AnsiString read GetConnection write SetConnection;
    property ContentLength: LongWord read GetContentLength write SetContentLength;
  end;
  
  TDzHttpRequest = class(TDzHttpPackage)
  private
    FPath: AnsiString;
    fMethod: AnsiString;
    fHost: AnsiString;
    fPort: Integer;
    fUsername: AnsiString;
    fPassword: AnsiString;
    fContent: TStream;
    procedure SetMethod(const Value: AnsiString);
    procedure SetPassword(const Value: AnsiString);
    procedure SetPath(const Value: AnsiString);
    procedure SetContent(const Value: TStream);
    procedure SetUsername(const Value: AnsiString);
    function GetAccept: AnsiString;
    procedure SetAccept(const Value: AnsiString);
    function GetReferer: AnsiString;
    procedure SetReferer(const Value: AnsiString);
    function GetAcceptEncoding: AnsiString;
    procedure SetAcceptEncoding(const Value: AnsiString);
    procedure SetHost(const Value: AnsiString);
    function GetUserAgent: AnsiString;
    procedure SetUserAgent(const Value: AnsiString);
    function GetHeaderHost: AnsiString;
    procedure SetHeaderHost(const Value: AnsiString);
    function GetUrl: AnsiString;
    procedure SetUrl(const Value: AnsiString);
    procedure SetPort(const Value: Integer);
  public
    procedure Assign(Other: TDzHttpRequest);
    property Url: AnsiString read GetUrl write SetUrl;
    property Method: AnsiString read fMethod write SetMethod;
    property Host: AnsiString read fHost write SetHost;
    property Port: Integer read fPort write SetPort;
    property Path: AnsiString read fPath write SetPath;
    property Username: AnsiString read fUsername write SetUsername;
    property Password: AnsiString read fPassword write SetPassword;
    property Content: TStream read fContent write SetContent;
    property UserAgent: AnsiString read GetUserAgent write SetUserAgent;
    property HeaderHost: AnsiString read GetHeaderHost write SetHeaderHost;
    property Accept: AnsiString read GetAccept write SetAccept;
    property AcceptEncoding: AnsiString read GetAcceptEncoding write SetAcceptEncoding;
    property Referer: AnsiString read GetReferer write SetReferer;
  end;

  TDzHttpContentEncoding = (encNone, encGzip, encDeflate);

  TObjMethod = procedure of object;
  
  TDzHttpResponse = class(TDzHttpPackage)
  private
    fStatusCode: Integer;
    fStatusText: AnsiString;
    fChunked: Boolean;
    fContentEncoding: TDzHttpContentEncoding;
    fContent: TStream;
    fState: THttpResponseState;
    fOnHeaderComplete: TObjMethod;
    fOnRequestComplete: TObjMethod;
    procedure SetTransferEncoding(const Value: AnsiString);
    function GetContentEncoding: AnsiString;
    function GetTransferEncoding: AnsiString;
    procedure SetContentEncoding(const Value: AnsiString);
    function GetChunkedTransfer: Boolean;
    procedure SetChunkedTransfer(const Value: Boolean);
    
    function parseHeader(buf: PAnsiChar; len: LongWord): LongWord;
    function parseChunkSize(buf: PAnsiChar; len: LongWord): LongWord;
    function parseHeaderLine(buf: PAnsiChar; len: LongWord): Boolean;
    function parseChunkedContent(buf: PAnsiChar; len: LongWord): LongWord;
    procedure headerComplete;
    procedure DoRequestComplete;
    procedure writeContent(const buf: Pointer; len: Integer);
  protected
    RespHeaderBuf: array [0..1023] of AnsiChar;
    RespHdrBufLen: LongWord;
    ChunkHeader: AnsiChar;
    CurChunkSize: LongWord;
    F: Integer;
    ContentLen: LongWord;
    readContentLength: LongWord;
    zlibStrm: TZStreamRec;
  public
    procedure initStream;
    procedure finalizeStream;
    function write(buf: PAnsiChar; len: LongWord): LongWord;
    property StatusCode: Integer read fStatusCode;
    property StatusText: AnsiString read fStatusText;
    property Chunked: Boolean read fChunked;
    property State: THttpResponseState read fState;
    property Content: TStream read fContent write fContent;
    property ContentEncoding: AnsiString read GetContentEncoding write SetContentEncoding;
    property TransferEncoding: AnsiString read GetTransferEncoding write SetTransferEncoding;
    property ChunkedTransfer: Boolean read GetChunkedTransfer write SetChunkedTransfer;
    property OnDoHeaderReceived: TObjMethod read fOnHeaderComplete write fOnHeaderComplete;
    property OnDoRequestComplete: TObjMethod read fOnRequestComplete write fOnRequestComplete;
  end;

  EDzHttpTimeout = class(Exception);
  EDzHttpErrorResponse = class(Exception);
  THttpErrorProc = procedure(Sender: TObject; ErrorCode: THttpErrorCode) of object;

  TDzCustomHttpClient = class(TDzCustomClientSocket)
  private
    fIOService: TDzIocpIOService;
    fTimeout: LongWord;
    fRedirect: Boolean;
    fReadBuffer: Pointer;
    fReadBufferSize: LongWord;
    fCurBufferSize: LongWord;
    Header: TDzAnsiStrStream;
    Event: THandle;
    fRequest: TDzHttpRequest;
    fResponse: TDzHttpResponse;
    procedure SetReadBufferSize(const Value: LongWord);
    procedure SetIOService(const Value: TDzIocpIOService);
    procedure PrepareHeader;
    procedure OnConnect;
    procedure OnReceive(len: LongWord; AllowException: Boolean);
    procedure OnConnectionReset(SockError: Integer; AllowException: Boolean);
    procedure DecideKeepConnection;
    procedure BeforeSendRequest;
  private
    procedure OnConnected(Sender: TDzIocpIOService; Socket: TDzCustomClientSocket;
      Operation: PDzAsyncConnect);
    procedure OnRecved(Sender: TDzIocpIOService; Socket: TDzCustomConnection;
      Operation: PDzAsyncRecv);
  protected
    procedure DoBeforeReadResponse; virtual;
    procedure DoBeforeSendRequest; virtual;
    procedure DoHeaderReceived; virtual;
    procedure DoRequestComplete; virtual;
    procedure DoError(ErrorCode: THttpErrorCode); virtual;
  public
    constructor Create; override;
    destructor Destroy; override;
    
    procedure DoUrl(const Method, Url: AnsiString; Param, Data: TStream; async: Boolean = False);
    procedure DoRequest(aRequest: TDzHttpRequest; aResponse: TDzHttpResponse;
      async: Boolean = False); overload;

    procedure DoRequest; overload;

    procedure DoRequest(const aMethod, aHost, aPath, aUsername, aPassword: AnsiString;
      aRequestData, aResponseData: TStream; aPort: Word; async: Boolean = False); overload;

    procedure DoAsyncRequest; overload;

    procedure Get(const Url: AnsiString; Data: TStream); overload;
    function Get(const Url: AnsiString): AnsiString; overload;
    procedure Post(const Url: AnsiString; Param, Data: TStream); overload;
    function Post(const Url, Param: AnsiString): AnsiString; overload;

    procedure AsyncGet(const Url: AnsiString; Data: TStream);
    procedure AsyncPost(const Url: AnsiString; Param, Data: TStream);
    
    property Timeout: LongWord read fTimeout write fTimeout;
    property ReadBufferSize: LongWord read fReadBufferSize write SetReadBufferSize;
    property Redirect: Boolean read fRedirect write fRedirect;
    property Request: TDzHttpRequest read fRequest;
    property Response: TDzHttpResponse read fResponse;
    property IOService: TDzIocpIOService read fIOService write SetIOService;
  end;

  TDzHttpClient = class(TDzCustomHttpClient)
  private
    fOnBeforeSendRequest: TNotifyEvent;
    fOnHeaderComplete: TNotifyEvent;
    fOnRequestComplete: TNotifyEvent;
    fOnError: THttpErrorProc;
  protected
    procedure DoBeforeSendRequest; override;
    procedure DoHeaderReceived; override;
    procedure DoRequestComplete; override;
    procedure DoError(ErrorCode: THttpErrorCode); override;
  public
    property OnBeforeSendRequest: TNotifyEvent read fOnBeforeSendRequest write fOnBeforeSendRequest;
    property OnHeaderComplete: TNotifyEvent read fOnHeaderComplete write fOnHeaderComplete;
    property OnRequestomplete: TNotifyEvent read fOnRequestComplete write fOnRequestComplete;
    property OnError: THttpErrorProc read fOnError write fOnError;
  end;

function UrlEncode(const src: WideString): AnsiString; overload;
function UrlEncode(const src: UTF8String): AnsiString; overload;

implementation

type
  TMultiBuffer = object
  private
  end;

function UrlEncodeLength(const src: UTF8String): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(src) do
  begin
    case Src[i] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.': Inc(Result);
      else Inc(Result, 3);
    end;
  end;
end;

function UrlEncode(const src: UTF8String): AnsiString;
var
  Idx: Integer;
  pch: PAnsiChar;
  ch: Byte;
const
  HEX_CHARS: array [0..15] of AnsiChar =
    ('0', '1', '2', '3', '4', '5', '6', '7',
     '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
begin
  SetLength(Result, UrlEncodeLength(src));
  pch := PAnsiChar(Result);
  for Idx := 1 to Length(src) do
  begin
    case Src[Idx] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.':
        begin
          pch^ := src[Idx];
          Inc(pch);
        end;
      else begin
        pch^ := '%';
        Inc(pch);
        ch := Ord(src[Idx]);
        pch^ := HEX_CHARS[ch shr 4];
        Inc(pch);
        pch^ := HEX_CHARS[ch and $0f];
        Inc(pch);
      end;
    end;
  end;
end;

function UrlEncode(const src: WideString): AnsiString;
begin
  Result := UrlEncode(Utf8Encode(src));
end;

{ TDzCustomHttpClient }

procedure TDzCustomHttpClient.AsyncGet(const Url: AnsiString; Data: TStream);
begin
  DoUrl('GET', Url, nil, Data, True);
end;

procedure TDzCustomHttpClient.AsyncPost(const Url: AnsiString; Param, Data: TStream);
begin
  DoUrl('POST', Url, Param, Data, True);
end;

procedure TDzCustomHttpClient.BeforeSendRequest;
const
  SInternetExplorer8UserAgent = 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.2; Trident/4.0)';
begin
  DoBeforeSendRequest;
  if Assigned(fRequest.Content) then fRequest.ContentLength := fRequest.Content.Size
  else fRequest.ContentLength := 0;
  if fRequest.Username <> '' then
    fRequest.AddHeader('Authorization', 'Basic ' + Base64Encode(
      fRequest.Username + ':' + fRequest.Password));
  if fRequest.UserAgent = '' then
    fRequest.UserAgent := SInternetExplorer8UserAgent;
  if fRequest.HeaderHost = '' then
    fRequest.HeaderHost := fRequest.Host;
end;

procedure TDzCustomHttpClient.DoBeforeReadResponse;
begin
  if fReadBufferSize <> fCurBufferSize then
  begin
    if Assigned(fReadBuffer) then
      fReadBuffer := System.ReallocMemory(fReadBuffer, fReadBufferSize)
    else
      fReadBuffer := System.GetMemory(fReadBufferSize);
    fCurBufferSize := fReadBufferSize;
  end;
end;

procedure TDzCustomHttpClient.DoBeforeSendRequest;
begin
end;

procedure TDzCustomHttpClient.DoRequestComplete;
var
  ConnToken: AnsiString;
begin
  fResponse.finalizeStream;
  ConnToken := fResponse.Connection;
  if SameText(ConnToken, 'Close') then Close;
end;

constructor TDzCustomHttpClient.Create;
begin
  inherited;
  fRequest := TDzHttpRequest.Create;
  fResponse := TDzHttpResponse.Create;
  fResponse.OnDoHeaderReceived := Self.DoHeaderReceived;
  fResponse.OnDoRequestComplete := Self.DoRequestComplete;
  fTimeout := 30000;
  fReadBufferSize := 4096;
  Event := WSACreateEvent;
  Header := TDzAnsiStrStream.Create('');
  Header.Size := 2048;
end;

procedure TDzCustomHttpClient.DecideKeepConnection;
var
  SockAddr: TDzSockAddrUnion;
  AddrLen: Integer;
begin
  if not Self.Connected then Exit;
  AddrLen := SizeOf(SockAddr);
  if uDZWinsock2.getpeername(Handle, @SockAddr, AddrLen) = SOCKET_ERROR then Exit;
  if (Self.RemotePort <> fRequest.Port) or not isAddressOfHost(
    PAnsiChar(fRequest.Host), SockAddr.unknown.sin_family,
    @SockAddr.unknown.sin_zero) then Self.Close;
end;

destructor TDzCustomHttpClient.Destroy;
begin
  fRequest.Free;
  fResponse.Free;
  Header.Free;
  WSACloseEvent(Event);
  if Assigned(fReadBuffer) then
    System.FreeMemory(fReadBuffer);
  inherited;
end;

procedure TDzCustomHttpClient.DoUrl(const Method, Url: AnsiString; Param, Data: TStream; async: Boolean);
var
  UrlComp: TDzURLComponents;
begin
  if not ParseUrl(Url, UrlComp) then
    raise EDzInvalidUrl.CreateFmt('"%s" is not a invalid url', [string(Url)]);
  DoRequest(Method, UrlComp.Host, UrlComp.PathWithParams, UrlComp.UserName,
    UrlComp.Password, Param, Data, UrlComp.Port, async);
end;

procedure TDzCustomHttpClient.DoAsyncRequest;
var
  Callback: TDzAsyncCallback;
begin
  Response.initStream;
  DecideKeepConnection;
  if not Connected then
  begin
    AllocateHandle(AF_INET, SOCK_STREAM, nil, True);
    fIOService.Bind(Self.Handle, Self);
    TMethod(Callback).Code := @TDzCustomHttpClient.OnConnected;
    TMethod(Callback).Data := Self;
    AsyncConnect(fRequest.Host, fRequest.Port, Callback);
  end
  else begin
    fIOService.Bind(Self.Handle, Self);
    Self.OnConnect;
  end;
end;

procedure TDzCustomHttpClient.DoError(ErrorCode: THttpErrorCode);
begin
  Close;
  fResponse.finalizeStream;
end;

procedure TDzCustomHttpClient.DoRequest(aRequest: TDzHttpRequest; aResponse: TDzHttpResponse;
  async: Boolean);
begin
  fRequest.Assign(aRequest);
  fResponse.Content := aResponse.Content;
  if async then DoAsyncRequest
  else DoRequest;
end;

function TDzCustomHttpClient.Get(const Url: AnsiString): AnsiString;
var
  SS: TDzAnsiStrStream;
begin
  SS := TDzAnsiStrStream.Create('');
  try
    Get(Url, SS);
    Result := SS.DataString;
  finally
    SS.Free;
  end;
end;

procedure TDzCustomHttpClient.DoHeaderReceived;
begin

end;

procedure TDzCustomHttpClient.OnConnect;
var
  errorCode: Integer;
  callback: TDzAsyncCallback;
begin
  BeforeSendRequest;
  PrepareHeader;
  Write(Pointer(Header.DataString)^, Header.Position);
  if Assigned(fRequest.Content) then
  begin
    fRequest.Content.Seek(0, soFromBeginning);
    WriteStream(fRequest.Content, Integer(fRequest.Content.Size));
  end;
  DoBeforeReadResponse;
  TMethod(callback).Data := Self;
  TMethod(callback).Code := @TDzCustomHttpClient.OnRecved;
  if not AsyncRecv(fReadBuffer^, fCurBufferSize, callback, @errorCode, 0) then
    Self.OnConnectionReset(errorCode, False);
end;

procedure TDzCustomHttpClient.OnConnectionReset(SockError: Integer; AllowException: Boolean);
begin
  Self.Close;
  if (fResponse.State = hssContent) and (fResponse.ContentLength = INVALID_CONTENT_LENGTH) then
    DoRequestComplete
  else if AllowException then
    raise EDzSocketException.Create('WSARecv', SockError)
  else
    Self.DoError(errRecv);
end;

procedure TDzCustomHttpClient.OnReceive(len: LongWord; AllowException: Boolean);
var
  used: LongWord;
begin
  used := fResponse.write(fReadBuffer, len);
  if used = LongWord(-1) then
  begin
    Close;
    fResponse.finalizeStream;
    if AllowException then
      raise EDzHttpErrorResponse.Create('invalid http response format')
    else Self.DoError(errInvalidStream);
  end;
end;

procedure TDzCustomHttpClient.Get(const Url: AnsiString; Data: TStream);
begin
  DoUrl('GET', Url, nil, Data);
end;

function TDzCustomHttpClient.Post(const Url, Param: AnsiString): AnsiString;
var
  PS, SS: TDzAnsiStrStream;
begin
  PS := TDzAnsiStrStream.Create(Param);
  SS := TDzAnsiStrStream.Create('');
  try
    Post(Url, PS, SS);
    Result := SS.DataString;
  finally
    PS.Free;
    SS.Free;
  end;
end;

procedure TDzCustomHttpClient.Post(const Url: AnsiString; Param, Data: TStream);
begin
  DoUrl('POST', Url, Param, Data);
end;

procedure TDzCustomHttpClient.DoRequest(const aMethod, aHost, aPath, aUsername, aPassword: AnsiString;
  aRequestData, aResponseData: TStream; aPort: Word; async: Boolean);
begin
  fRequest.Method := aMethod;
  fRequest.Port := aPort;
  fRequest.Path := aPath;
  fRequest.Username := aUsername;
  fRequest.Password := aPassword;
  fRequest.Content := aRequestData;
  fResponse.Content := aResponseData;
  fRequest.Host := aHost;
  fResponse.Content := aResponseData;
  if async then DoAsyncRequest
  else DoRequest;
end;


procedure TDzCustomHttpClient.DoRequest;
var
  Operation: TDzAsyncOperation;
  BytesRead, Flags: LongWord;
  LastErr: Integer;
  callback: TDzAsyncCallback;
begin
  Response.initStream;
  DecideKeepConnection;
  if not Connected then
  begin
    AllocateHandle(AF_INET, SOCK_STREAM, nil, True);
    Connect(fRequest.Host, fRequest.Port);
  end;
  try
    try
      BeforeSendRequest;
      PrepareHeader;
      Write(Pointer(Header.DataString)^, Header.Position);
      if Assigned(fRequest.Content) then
      begin
        fRequest.Content.Seek(0, soFromBeginning);
        WriteStream(fRequest.Content, Integer(fRequest.Content.Size));
      end;
      DoBeforeReadResponse;
      TMethod(callback).Data := Self;
      TMethod(callback).Code := @TDzCustomHttpClient.OnRecved;
      while True do
      begin
        FillChar(Operation, SizeOf(Operation), 0);
        Operation.Overlapped.hEvent := Event;
        WSAResetEvent(Event);
        if not AsyncRecv2(fReadBuffer^, fReadBufferSize - 1,
          @Operation.Overlapped, @LastErr, 0) then
        begin
          OnConnectionReset(LastErr, True);
          Break;
        end;
        if WSAWaitForMultipleEvents(1, @Event, False, Timeout, False) = WAIT_OBJECT_0 then
        begin
          WSAGetOverlappedResult(Handle, @Operation.Overlapped, BytesRead, False, Flags);
          if BytesRead = 0 then
          begin
            OnConnectionReset(WSAECONNRESET, True);
            Break;
          end;
          OnReceive(BytesRead, True);
          if fResponse.State = hssComplete then  Break;
        end
        else raise EDzHttpTimeout.Create('read timeout.');
      end;
    except
      Close;
      raise;
    end;
  finally
    fResponse.finalizeStream;;
  end;
end;

procedure TDzCustomHttpClient.PrepareHeader;
var
  Node: PAnsiAnsiLinkListNode;
begin
  Header.Seek(0, soFromBeginning);
  Header.WriteString(fRequest.Method);
  Header.WriteString(' ');
  Header.WriteString(fRequest.Path);
  Header.WriteString(' HTTP/1.1'#13#10);
  Node := fRequest.Header.ListHead;
  while Assigned(Node) do
  begin
    Header.WriteString(Node.Data.Key);
    Header.WriteString(': ');
    Header.WriteString(Node.Data.Value);
    Header.WriteString(#13#10);
    Node := Node.Next;
  end;
  Header.WriteString(#13#10);
end;

procedure TDzCustomHttpClient.SetIOService(const Value: TDzIocpIOService);
begin
  fIOService := Value;
end;

procedure TDzCustomHttpClient.SetReadBufferSize(const Value: LongWord);
begin
  if Value = 0 then fReadBufferSize := 4096
  else fReadBufferSize := Value;
end;

procedure TDzCustomHttpClient.OnConnected(Sender: TDzIocpIOService;
  Socket: TDzCustomClientSocket; Operation: PDzAsyncConnect);
var
  BytesRead, Flags: LongWord;
begin
  try
    if WSAGetOverlappedResult(Handle, @Operation.inherit.Overlapped,
      BytesRead, False, Flags) then
    begin
      UpdateConnectContext;
      OnConnect;
    end
    else
      DoError(errConnect);
  finally
    DeallocConnectOperation(Operation);
    Release;
  end;
end;

procedure TDzCustomHttpClient.OnRecved(Sender: TDzIocpIOService;
  Socket: TDzCustomConnection; Operation: PDzAsyncRecv);
var
  bytesRead, Flags: LongWord;
  errorCode: Integer;
  callback: TDzAsyncCallback;
begin
  try
    if WSAGetOverlappedResult(Handle, @Operation.inherit.Overlapped,
      bytesRead, False, Flags) then
    begin
      if bytesRead = 0 then OnConnectionReset(WSAECONNRESET, False)
      else begin
        OnReceive(bytesRead, False);
        if fResponse.State in [hssLine, hssHeader, hssContent] then
        begin
          TMethod(callback).Data := Self;
          TMethod(callback).Code := @TDzCustomHttpClient.OnRecved;
          if not AsyncRecv(fReadBuffer^, fCurBufferSize,
            callback, @errorCode, 0) then
            OnConnectionReset(errorCode, False);
        end;
      end;
    end
    else begin
      Close;
      DoError(errRecv);
    end;
  finally
    DeallocRecvOperation(Operation);
    Release;
  end;
end;

{ TDzHttpPackage }

procedure TDzHttpPackage.AddHeader(const Name, Value: AnsiString);
begin
  fHeader.SetItem(Name, Value);
end;

constructor TDzHttpPackage.Create;
begin
  fHeader := TAnsiAnsiMap.Create;
  fHeader.CaseSensitive := False;
end;

destructor TDzHttpPackage.Destroy;
begin
  fHeader.Free;
  inherited;
end;

function TDzHttpPackage.GetConnection: AnsiString;
begin
  Result := fHeader.GetItem('Connection');
end;

function TDzHttpPackage.GetContentLength: LongWord;
var
  V: AnsiString;
begin
  V := fHeader.GetItem('Content-Length');
  if V = '' then Result := LongWord(-1)
  else Result := StrToInt(V);
end;

function TDzHttpPackage.GetContentType: AnsiString;
begin
  Result := fHeader.GetItem('Content-Type');
end;

procedure TDzHttpPackage.SetConnection(const Value: AnsiString);
begin
  fHeader.SetItem('Connection', Value);
end;

procedure TDzHttpPackage.SetContentLength(const Value: LongWord);
begin
  if Value = 0 then fHeader.Delete('Content-Length')
  else fHeader.SetItem('Content-Length', IntToStr(Value));
end;

procedure TDzHttpPackage.SetContentType(const Value: AnsiString);
begin
  fHeader.SetItem('Content-Type', Value);
end;

{ TAnsiAnsiMap }

procedure TAnsiAnsiMap.Append(Map: TAnsiAnsiMap);
var
  it: TAnsiAnsiMapIterator;
  node: PAnsiAnsiLinkListNode;
begin
  it.SetMap(Map);
  while not it.Eof do
  begin
    New(node);
    node.Next := fListHead;
    fListHead := node;
    node.Data.Key := it.Key;
    node.Data.Value := it.Value;
    it.Next;
  end; 
end;

procedure TAnsiAnsiMap.Assign(Map: TAnsiAnsiMap);
begin
  Clear;
  Append(Map);
end;

procedure TAnsiAnsiMap.Clear;
var
  Temp: PAnsiAnsiLinkListNode;
begin
  while Assigned(fListHead) do
  begin
    Temp := fListHead.Next;
    Dispose(fListHead);
    fListHead := Temp;
  end; 
end;

constructor TAnsiAnsiMap.Create;
begin

end;

procedure TAnsiAnsiMap.Delete(const Key: AnsiString);
var
  Node: PAnsiAnsiLinkListNode;
  Prev: PAnsiAnsiLinkListNode;
begin
  Node := FindItem(Key, @Prev);
  if not Assigned(Node) then Exit;
  if Assigned(Prev) then Prev.Next := Node.Next
  else fListHead := Node.Next;
  Dispose(Node);
end;

destructor TAnsiAnsiMap.Destroy;
begin
  Self.Clear;
  inherited;
end;

function TAnsiAnsiMap.Exists(const Key: AnsiString): Boolean;
begin
  Result := Assigned(FindItem(Key));
end;

function TAnsiAnsiMap.FindItem(const Key: AnsiString;
  Prev: PPAnsiAnsiLinkListNode): PAnsiAnsiLinkListNode;
var
  Temp, Node: PAnsiAnsiLinkListNode;
begin
  Temp := nil;
  Node := fListHead;
  while Assigned(Node) do
  begin
    if fCaseSensitive then
    begin
      if Node.Data.Key = Key then
      begin
        Result := Node;
        if Assigned(Prev) then Prev^ := Temp;
        Exit;
      end;
    end
    else begin
      if SameText(Node.Data.Key, Key) then
      begin
        Result := Node;
        if Assigned(Prev) then Prev^ := Temp;
        Exit;
      end;
    end;
    Temp := Node;
    Node := Node.Next;
  end;
  Result := nil;
end;

function TAnsiAnsiMap.GetItem(const Key: AnsiString): AnsiString;
var
  Node: PAnsiAnsiLinkListNode;
begin
  Node := FindItem(Key);
  if Assigned(Node) then Result := Node.Data.Value
  else Result := '';
end;

procedure TAnsiAnsiMap.SetItem(const Key, Value: AnsiString);
var
  Node: PAnsiAnsiLinkListNode;
begin
  Node := FindItem(Key);
  if Assigned(Node) then Node.Data.Value := Value
  else begin
    New(Node);
    Node.Next := fListHead;
    fListHead := Node;
    Node.Data.Key := Key;
    Node.Data.Value := Value;
  end;
end;

{ TAnsiAnsiMapIterator }

function TAnsiAnsiMapIterator.Eof: Boolean;
begin
  Result := not Assigned(Node);
end;

function TAnsiAnsiMapIterator.GetKey: AnsiString;
begin
  Result := Node.Data.Key;
end;

function TAnsiAnsiMapIterator.GetValue: AnsiString;
begin
  Result := Node.Data.Value;
end;

procedure TAnsiAnsiMapIterator.Next;
begin
  Node := Node.Next;
end;

procedure TAnsiAnsiMapIterator.SetMap(const Map: TAnsiAnsiMap);
begin
  Node := Map.ListHead;
end;

procedure TAnsiAnsiMapIterator.SetValue(const AValue: AnsiString);
begin
  Node.Data.Value := AValue;
end;

{ TDzHttpResponse }

procedure TDzHttpResponse.DoRequestComplete;
var
  dest: array [0..4095] of Byte;
begin
  zlibStrm.next_in := nil;
  zlibStrm.avail_in := 0;
  zlibStrm.next_out := @dest;
  zlibStrm.avail_out := SizeOf(dest);
  inflate(zlibStrm, Z_FINISH);
  fContent.WriteBuffer(dest, SizeOf(dest) - zlibStrm.avail_out);
  if Assigned(fOnRequestComplete) then fOnRequestComplete;  
end;

procedure TDzHttpResponse.finalizeStream;
begin
  if fContentEncoding in [encDeflate, encGzip] then
  begin
    fContentEncoding := encNone;
    inflateEnd(zlibStrm);
  end;
end;

procedure TDzHttpResponse.headerComplete;
var
  enc: AnsiString;
begin
  ContentLen := Self.ContentLength;
  fChunked := Self.ChunkedTransfer;
  enc := Self.ContentEncoding;
  if SameText(enc, 'gzip') then
  begin
    fContentEncoding := encGzip;
    FillChar(zlibStrm, SizeOf(zlibStrm), 0);
    inflateInit2(zlibStrm, 47);
  end
  else if SameText(enc, 'deflate') then
  begin
    fContentEncoding := encDeflate;
    FillChar(zlibStrm, SizeOf(zlibStrm), 0);
    inflateInit(zlibStrm);
  end
  else fContentEncoding := encNone;
  
  if Chunked then
  begin
    F := 0;
    ChunkHeader := 'a';
    CurChunkSize := 0;
  end;
  if Assigned(fOnHeaderComplete) then fOnHeaderComplete;  
end;

procedure TDzHttpResponse.initStream;
begin
  fHeader.Clear;
  fState := hssHeader;
  RespHdrBufLen := 0;
  fStatusCode := -1;
  fStatusText := '';
  fContentEncoding := encNone;
  ContentLen := INVALID_CONTENT_LENGTH;
  Self.readContentLength := 0;
  F := 0;
end;

function TDzHttpResponse.parseChunkSize(buf: PAnsiChar; len: LongWord): LongWord;
var
  i: Integer;
  ptr: PAnsiChar;
begin
  Result := LongWord(-1);
  ptr := buf;
  if ChunkHeader = 'a' then
  begin
    while (ptr < buf + len) and not (ptr^ in [#13, ';']) do Inc(ptr);
    for i := 0 to ptr - buf - 1 do
    begin
      case buf[i] of
        '0'..'9': CurChunkSize := CurChunkSize shl 4 + PByte(buf + i)^ and $0f;
        'a'..'f', 'A'..'F':
          CurChunkSize := CurChunkSize shl 4 + PByte(buf + i)^ and $0f + 9;
        #32: ;
        else Exit;
      end;
    end;
    if ptr = buf + len then
    begin
      Result := len;
      Exit;
    end
    else if ptr^ = ';' then ChunkHeader := 'b'
    else ChunkHeader := 'c';
  end;

  if ChunkHeader = 'b' then
  begin
    Inc(ptr);
    while (ptr < buf + len) and (ptr^ <> #13) do Inc(ptr);
    if ptr = buf + len then
    begin
      Result := len;
      Exit;
    end
    else ChunkHeader := 'c';
  end;
  
  if ChunkHeader = 'c' then
  begin
    Inc(ptr);
    if ptr = buf + len then
    begin
      Result := len;
      Exit;
    end;

    if ptr^ <> #10 then Exit;

    Result := ptr - buf + 1;
    ChunkHeader := 'z';
    Exit;
  end;
end;

function TDzHttpResponse.parseHeaderLine(buf: PAnsiChar; len: LongWord): Boolean;
var
  ptr, temp: PAnsiChar;
  name, value: AnsiString;
begin
  Result := False;
  ptr := buf;
  if fStatusCode = -1 then
  begin
    while (ptr < buf + len) and (ptr^ <> #32) do Inc(ptr);
    if ptr = buf + len then Exit;
    while (ptr < buf + len) and (ptr^ = #32) do Inc(Ptr);
    if ptr = buf + len then Exit;
    fStatusCode := 0;
    while ptr < buf + len do
    begin
      if ptr^ in ['0'..'9'] then
        fStatusCode := fStatusCode * 10 + PByte(ptr)^ and $0f
      else if ptr^ = #32 then Break
      else Exit;
      Inc(ptr);
    end;
    while (ptr < buf + len) and (ptr^ = #32) do Inc(ptr);
    if ptr = buf + len then Exit;
    SetString(fStatusText, ptr, buf + len - Ptr);
  end
  else begin
    while (ptr < buf + len) and (ptr^ <> ':') do Inc(ptr);
    if ptr = buf + len then Exit;
    temp := ptr;
    Inc(ptr);
    while (ptr < buf + len) and (ptr^ = #32) do Inc(ptr);
    if ptr = buf + len then Exit;
    SetString(name, buf, temp - buf);
    SetString(value, ptr, buf + len - Ptr);
    Header.SetItem(name, value);
  end;
  Result := True;
end;

function TDzHttpResponse.parseHeader(buf: PAnsiChar; len: LongWord): LongWord;
var
  temp, ptr: PAnsiChar;
begin
  Result := LongWord(-1);
  ptr := buf;
  while ptr < buf + len do
  begin
    temp := ptr;
    if (RespHdrBufLen = 0) or (RespHeaderBuf[RespHdrBufLen - 1] <> #13) then
    begin
      while (ptr < buf + len) and (ptr^ <> #13) do Inc(ptr);
      if ptr = buf + len then
      begin
        Move(temp^, RespHeaderBuf[RespHdrBufLen], ptr - temp);
        Inc(RespHdrBufLen, ptr - temp);
        Result := len;
        Exit;
      end;
      if RespHdrBufLen = 0 then
      begin
        if ptr = temp then
        begin
          RespHeaderBuf[0] := #13;
          RespHeaderBuf[1] := #10;
          RespHeaderBuf[2] := #13;
          RespHdrBufLen := 3;
          Inc(ptr);
          Continue;
        end
        else begin
          if parseHeaderLine(temp, ptr - temp) then Inc(ptr)
          else Exit;
        end;
      end
      else begin
        Move(temp^, RespHeaderBuf[RespHdrBufLen], ptr - temp);
        ParseHeaderLine(RespHeaderBuf, RespHdrBufLen + LongWord(ptr - temp));
        Inc(ptr);
      end;
      RespHeaderBuf[0] := #13;
      RespHdrBufLen := 1;
    end
    else begin
      if ptr^ <> #10 then Exit;
      Inc(ptr);
      if RespHdrBufLen = 1 then RespHdrBufLen := 0
      else begin
        RespHdrBufLen := 0;
        fState := hssContent;
        Break;
      end;
    end;
  end;
  Result := ptr - buf;
end;

function TDzHttpResponse.parseChunkedContent(buf: PAnsiChar; len: LongWord): LongWord;
var
  ptr: PAnsiChar;
  used: LongWord;
begin
  ptr := buf;
  while len > 0 do
  begin
    //#13#10 after every chunk data
    if F = 1 then
    begin
      if ptr^ <> #13 then
      begin
        Result := DWORD(-1);
        Exit;
      end;
      Inc(ptr);
      Dec(len);
      F := 2;
      Continue;
    end
    else if F = 2 then
    begin
      if Ptr^ <> #10 then
      begin 
        Result := DWORD(-1);
        Exit;
      end;
      Inc(Ptr);
      Dec(len);
      F := 0;
      Continue;
    end;
                     
    if ChunkHeader <> 'z' then
    begin
      used := parseChunkSize(ptr, len);
      if used = LongWord(-1) then
      begin 
        Result := DWORD(-1);
        Exit;
      end;
      Inc(ptr, used);
      Dec(len, used);
      if (ChunkHeader = 'z') and (CurChunkSize = 0) then 
      begin
        fState := hssComplete;
        DoRequestComplete;
        Break;
      end;
    end;

    if (ChunkHeader = 'z') and (len > 0) then
    begin
      if CurChunkSize - readContentLength > len then
      begin
        writeContent(ptr, len);
        Inc(readContentLength, len);
        Inc(ptr, len);
        Break;
      end
      else begin
        writeContent(ptr, CurChunkSize - readContentLength);
        Inc(ptr, CurChunkSize - readContentLength);
        Dec(len, CurChunkSize - readContentLength);
        ChunkHeader := 'a';
        CurChunkSize := 0;
        readContentLength := 0;
        F := 1;
      end;
    end;
  end;
  Result := ptr - buf;
end;

function TDzHttpResponse.write(buf: PAnsiChar; len: LongWord): LongWord;
var
  used: LongWord;
  ptr: PAnsiChar;
begin
  Result := len;
  if fState = hssHeader then
  begin
    used := ParseHeader(buf, len);
    if used = LongWord(-1) then
    begin
      fState := hssError;
      Result := DWORD(-1);
      Exit;
    end;
    
    Dec(len, used);  
    ptr := buf + used;
    
    if fState = hssContent then
    begin
      headerComplete;
      if (fStatusCode = 202) or (fStatusCode = 304) or (ContentLen = 0) then
      begin
        fState := hssComplete;
        Result := used;
        Exit;
      end;
    end;
  end
  else ptr := buf;

  if len = 0 then Exit;
  
  if Chunked then
  begin
    used := parseChunkedContent(ptr, len);
    if used = DWORD(-1) then 
    begin 
      fState := hssError;
      Result := DWORD(-1);
      Exit;
    end;  
    if fState = hssComplete then 
    begin
      Result := ptr + used - buf;
      Exit; 
    end;  
  end
  else begin
    if ContentLen - readContentLength > len then
    begin
      writeContent(ptr, len);
      Inc(readContentLength, len);
      Exit;
    end
    else begin 
      writeContent(ptr, ContentLen - readContentLength);
      DoRequestComplete;
      fState := hssComplete;
      Result := ptr + ContentLen - readContentLength - buf;
      readContentLength := ContentLen;
      Exit;
    end;
  end;
end;

procedure TDzHttpResponse.writeContent(const buf: Pointer; len: Integer);
var
  dest: array [0..4095] of Byte;
  ret: Integer;
begin
  if fContentEncoding = encNone then
    fContent.WriteBuffer(buf^, len)
  else begin
    zlibStrm.next_in := buf;
    zlibStrm.avail_in := len;
    while zlibStrm.avail_in > 0 do
    begin
      zlibStrm.next_out := @dest;
      zlibStrm.avail_out := SizeOf(dest);
      ret := inflate(zlibStrm, Z_NO_FLUSH);
      if ret in [Z_OK, Z_STREAM_END] then
        fContent.WriteBuffer(dest, SizeOf(dest) - zlibStrm.avail_out)
      else
        raise EZCompressionError.Create(ret);
    end;
  end;
end;

function TDzHttpResponse.GetChunkedTransfer: Boolean;
var
  V: AnsiString;
begin
  V := TransferEncoding;
  if V = '' then Result := False
  else Result := Pos('chunked', V) > 0;
end;

function TDzHttpResponse.GetContentEncoding: AnsiString;
begin
  Result := fHeader.GetItem('Content-Encoding');
end;

function TDzHttpResponse.GetTransferEncoding: AnsiString;
begin
  Result := fHeader.GetItem('Transfer-Encoding');
end;

procedure TDzHttpResponse.SetChunkedTransfer(const Value: Boolean);
var
  V: AnsiString;
begin
  V := TransferEncoding;
  if V = '' then TransferEncoding := 'chunked'
  else TransferEncoding := V + ',chunked';
end;

procedure TDzHttpResponse.SetContentEncoding(const Value: AnsiString);
begin
  fHeader.SetItem('Content-Encoding', Value);
end;

procedure TDzHttpResponse.SetTransferEncoding(const Value: AnsiString);
begin
  fHeader.SetItem('Transfer-Encoding', Value);
end;

{ TDzHttpRequest }

procedure TDzHttpRequest.SetMethod(const Value: AnsiString);
begin
  fMethod := Value;
end;

procedure TDzHttpRequest.SetPassword(const Value: AnsiString);
begin
  FPassword := Value;
end;

procedure TDzHttpRequest.SetPath(const Value: AnsiString);
begin
  fPath := Value;
end;

procedure TDzHttpRequest.SetPort(const Value: Integer);
begin
  fPort := Value;
end;

procedure TDzHttpRequest.SetContent(const Value: TStream);
begin
  fContent := Value;
end;

procedure TDzHttpRequest.SetUsername(const Value: AnsiString);
begin
  fUsername := Value;
end;

procedure TDzHttpRequest.Assign(Other: TDzHttpRequest);
begin
  Method := Other.Method;
  Host := Other.Host;
  Port := Other.Port;
  Path := Other.Path;
  Username := Other.Username;
  Password := Other.Password;
  Content := Other.Content;
  Header.Assign(Other.Header);
end;

function TDzHttpRequest.GetAccept: AnsiString;
begin
  Result := fHeader.GetItem('Accept');
end;

function TDzHttpRequest.GetAcceptEncoding: AnsiString;
begin
  Result := fHeader.GetItem('Accept-Encoding');
end;

function TDzHttpRequest.GetHeaderHost: AnsiString;
begin
  Result := fHeader.GetItem('Host');
end;

function TDzHttpRequest.GetReferer: AnsiString;
begin
  Result := fHeader.GetItem('Referer');
end;

function TDzHttpRequest.GetUrl: AnsiString;
begin

end;

function TDzHttpRequest.GetUserAgent: AnsiString;
begin
  Result := fHeader.GetItem('User-Agent');
end;

procedure TDzHttpRequest.SetAccept(const Value: AnsiString);
begin
  fHeader.SetItem('Accept', Value);
end;

procedure TDzHttpRequest.SetAcceptEncoding(const Value: AnsiString);
begin
  fHeader.SetItem('Accept-Encoding', Value);
end;

procedure TDzHttpRequest.SetHeaderHost(const Value: AnsiString);
begin
  fHeader.SetItem('Host', Value);
end;

procedure TDzHttpRequest.SetHost(const Value: AnsiString);
begin
  fHost := Value;
end;

procedure TDzHttpRequest.SetReferer(const Value: AnsiString);
begin
  fHeader.SetItem('Referer', Value);
end;

procedure TDzHttpRequest.SetUrl(const Value: AnsiString);
var
  UrlComp: TDzURLComponents;
begin
  if not ParseUrl(Value, UrlComp) then
    raise EDzInvalidUrl.CreateFmt('"%s" is not a invalid url', [string(Url)]);
  fHost := UrlComp.Host;
  fPort := UrlComp.Port;
  fPath := UrlComp.PathWithParams;
  fUserName := UrlComp.UserName;
  FPassword := UrlComp.Password;
end;

procedure TDzHttpRequest.SetUserAgent(const Value: AnsiString);
begin
  fHeader.SetItem('User-Agent', Value);
end;

{ TDzHttpClient }

procedure TDzHttpClient.DoBeforeSendRequest;
begin
  inherited;
  if Assigned(fOnBeforeSendRequest) then
    fOnBeforeSendRequest(Self);
end;

procedure TDzHttpClient.DoRequestComplete;
begin
  inherited;
  if Assigned(fOnRequestComplete) then
    fOnRequestComplete(Self);
end;

procedure TDzHttpClient.DoError(ErrorCode: THttpErrorCode);
begin
  inherited;
  if Assigned(fOnError) then
    fOnError(Self, ErrorCode);
end;

procedure TDzHttpClient.DoHeaderReceived;
begin
  inherited;
  if Assigned(fOnHeaderComplete) then
    fOnHeaderComplete(Self,);
end;

end.

